#
# Classifier for Netscape mailer (I think)
# One install identifies itself as InterMail v03.02.07 118-124-101,
# whatever that means.
#
package Mail::Bounce::Netscape;
use strict;

use vars qw(@ISA @patterns);

@ISA = qw(Mail::Bounce::Heuristic);

$patterns[0] = << 'EoF';
This Message was undeliverable due to the following reason:

The following destination addresses were unknown (please check
the addresses and re-mail the message):

${RECIP-.+}

Please reply to ${POSTMASTER-\S+}
if you feel this message to be in error.
EoF

# This pattern observed from mail.webwurx.com
$patterns[1] = << 'EoF';
This Message was undeliverable due to the following reason:

${DIAGNOSTIC-(?s:.+)}

The following recipients did not receive this message:

     <${RECIP-.+}>

Please reply to ${POSTMASTER-\S+}
if you feel this message to be in error.
EoF

# This pattern observed from server01.bnet.at
$patterns[2] = << 'EoF';
This Message was undeliverable due to the following reason:

${DIAGNOSTIC-(?s:.+)}

The following recipients haven't received this message:

     ${RECIP-.+}

Please reply to ${POSTMASTER-\S+}
if you feel this message to be in error.
EoF

# Pattern obtained from telekabel.at (teleweb.at)
$patterns[3] = << 'EoF';
This Message was undeliverable due to the following reason:

Each of the following recipients was rejected by a remote mail server.
The reasons given by the server are included to help you determine why
each recipient was rejected. 

    Recipient: <${RECIP-\S+}>
    Reason:    ${DIAGNOSTIC-.+}


Please reply to ${POSTMASTER-\S+}
if you feel this message to be in error.
EoF

# This pattern observed from mundo-r.com
# Like #1, but pattern of spaces is different
$patterns[4] = << 'EoF';
This Message was undeliverable due to the following reason:

${DIAGNOSTIC-(?s:.+)}
The following recipients did not receive this message:
     <${RECIP-.+}>

Please reply to ${POSTMASTER-\S+}
if you feel this message to be in error.
EoF

# This pattern observed from baldo.fub.it
# Complaining about originator!
$patterns[5] = << 'EoF';
This Message was undeliverable due to the following reason:

${DIAGNOSTIC-(?s:.+)}

The return address was '<${ORIGINATOR-\S+}>'

Please reply to ${POSTMASTER-\S+}
if you feel this message to be in error.
EoF

# Pattern observed from km0.com/nexo.es
$patterns[6] = << 'EoF';
This Message was undeliverable due to the following reason:

${LONGDIAG-(?s:.+)}

${DIAGNOSTIC-.*}: SMTP <${RECIP-.+}>

Please reply to ${POSTMASTER-\S+}
if you feel this message to be in error.
EoF

$patterns[7] = << 'EoF';
This Message was undeliverable due to the following reason:

${DIAGNOSTIC-(?s:.+)}

<${RECIP-.+}>

Please reply to ${POSTMASTER-\S+}
if you feel this message to be in error.
EoF

# The ultimate fallback pattern - no info on recipients at all
# Observed from ole.com when a loop was detected
$patterns[8] = << 'EoF';
This Message was undeliverable due to the following reason:

${DIAGNOSTIC-(?s:.+)}

Please reply to ${POSTMASTER-\S+}
if you feel this message to be in error.
EoF

sub validate {
    my $self = shift;
    my $report = $self->parts(0);
    return 0 if !$report;
    my $body = $report->bodyhandle();
    return 0 if !$body;
    my $keywords = $self->patternmatch($report->bodyhandle->as_string, @patterns);
    return defined($keywords);
}

    

sub recipients {
    my $self = shift;

    if (wantarray()) {
	my $res;
	my $report = $self->parts(0);
	die "No part 0" if !$report;
	my $body = $report->bodyhandle();
	die "No body" if !$body;
	my $keywords = $self->patternmatch($report->bodyhandle->as_string, @patterns);
	if (defined($keywords)) {
	    $res = new Mail::Bounce::Address;
	    if (defined($$keywords{DIAGNOSTIC})) {
		my $diag = $$keywords{DIAGNOSTIC};
		if ($diag =~ /a loop was found/) {
		    $res->type("tempfail");
		    $res->action("failed");
		    $res->status("4.0.0 (MX loop)");
		} elsif ($diag =~ /mailbox size limit/
			 || $diag eq "User quota exceeded"
			 || $diag =~ /temporarily over quota/) {
		    $res->type("tempfail");
		    $res->action("failed");
		    $res->status("4.0.0 (Mailbox full)");
		} else {
		    $res->type("permfail");
		    $res->action("failed");
		    $res->status("5.0.0 (Other error)");
		}
	    } else {
		$res->type("permfail");
		$res->action("failed");
		$res->status("5.1.1 (Unknown user)");
	    }
	    my $recip = $$keywords{RECIP};
	    if (!$recip) {
		$recip = "<no final recipient>";
		# see pattern 5 above
	    }
	    # difference between 2 variants of this mailer
	    $recip =~ s/^SMTP //;
	    $res->final_recipient("RFC822; $recip");
	} else {
	    die "Netscape: Unmatched pattern in recipients()\n";
	}
	return $res;
    } else {
	return 1;
    }
}
1;




